home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1372.ZIP / PIBCAT.ARC / PIBCATA.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-28  |  15KB  |  327 lines
  1. (*----------------------------------------------------------------------*)
  2. (*     Display_Archive_Contents --- Display contents of archive file    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Archive_Contents( ArcFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Archive_Contents                               *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of an archive (.ARC file)            *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Archive_Contents( ArcFileName : AnyStr );              *)
  16. (*                                                                      *)
  17. (*          ArcFileName --- name of archive file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Dir_Convert_Date_And_Time                                   *)
  25. (*                            --- convert DOS packed date/time to string*)
  26. (*          Open_File         --- open a file                           *)
  27. (*          Close_File        --- close a file                          *)
  28. (*          Entry_Matches     --- Perform wildcard match                *)
  29. (*          Display_Page_Titles                                         *)
  30. (*                            --- Display titles at top of page         *)
  31. (*          DUPL              --- Duplicate a character into a string   *)
  32. (*                                                                      *)
  33. (*----------------------------------------------------------------------*)
  34.  
  35. (*----------------------------------------------------------------------*)
  36. (*                  Map of Archive file entry header                    *)
  37. (*----------------------------------------------------------------------*)
  38.  
  39. TYPE
  40.    FNameType = ARRAY[1..13] OF CHAR;
  41.  
  42.    Archive_Entry_Type = RECORD
  43.                            Marker   : BYTE      (* Flags beginning of entry *);
  44.                            Version  : BYTE      (* Compression method       *);
  45.                            Filename : FNameType (* file and extension       *);
  46.                            Size     : LONGINT   (* Compressed size          *);
  47.                            Date     : WORD      (* Packed date              *);
  48.                            Time     : WORD      (* Packed time              *);
  49.                            CRC      : WORD      (* Cyclic Redundancy Check  *);
  50.                            OLength  : LONGINT   (* Original length          *);
  51.                         END;
  52.  
  53. CONST
  54.    Archive_Header_Length = 29      (* Length of an archive header entry *);
  55.    Archive_Marker        = 26      (* Marks start of an archive header  *);
  56.  
  57. VAR
  58.    ArcFile       : FILE                 (* Archive file to be read        *);
  59.    Archive_Entry : Archive_Entry_Type   (* Header for one file in archive *);
  60.    Archive_Pos   : LONGINT              (* Current byte offset in archive *);
  61.    Bytes_Read    : INTEGER              (* # bytes read from archive file *);
  62.    Ierr          : INTEGER              (* Error flag                     *);
  63.    Do_Blank_Line : BOOLEAN              (* TRUE to print blank line       *);
  64.  
  65. (*----------------------------------------------------------------------*)
  66. (*   Get_Next_Archive_Entry --- Get next header entry in archive        *)
  67. (*----------------------------------------------------------------------*)
  68.  
  69. FUNCTION Get_Next_Archive_Entry( VAR ArcEntry : Archive_Entry_Type;
  70.                                  VAR Error    : INTEGER ) : BOOLEAN;
  71.  
  72. (*----------------------------------------------------------------------*)
  73. (*                                                                      *)
  74. (*    Function:  Get_Next_Archive_Entry                                 *)
  75. (*                                                                      *)
  76. (*    Purpose:   Gets header information for next file in archive       *)
  77. (*                                                                      *)
  78. (*    Calling sequence:                                                 *)
  79. (*                                                                      *)
  80. (*       OK := Get_Next_Archive_Entry( VAR ArcEntry :                   *)
  81. (*                                         Archive_Entry_Type;          *)
  82. (*                                     VAR Error    : INTEGER ) :       *)
  83. (*                                     BOOLEAN;                         *)
  84. (*                                                                      *)
  85. (*          ArcEntry --- Header data for next file in archive           *)
  86. (*          Error    --- Error flag                                     *)
  87. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  88. (*                                                                      *)
  89. (*----------------------------------------------------------------------*)
  90.  
  91. BEGIN (* Get_Next_Archive_Entry *)
  92.                                    (* Assume no error to start *)
  93.    Error := 0;
  94.                                    (* Except first time, move to     *)
  95.                                    (* next supposed header record in *)
  96.                                    (* archive.                       *)
  97.  
  98.    IF ( Archive_Pos <> 0 ) THEN
  99.       Seek( ArcFile, Archive_Pos );
  100.  
  101.                                    (* Read in the file header entry. *)
  102.  
  103.    BlockRead( ArcFile, ArcEntry, Archive_Header_Length, Bytes_Read );
  104.    Error := 0;
  105.                                    (* If wrong size read, or header marker *)
  106.                                    (* byte is incorrect, report archive    *)
  107.                                    (* format error.                        *)
  108.  
  109.    IF ( ( Bytes_Read < Archive_Header_Length ) OR
  110.         ( ArcEntry.Marker <> Archive_Marker ) ) THEN
  111.       Error := Format_Error
  112.    ELSE                            (* Header looks ok -- see if it *)
  113.                                    (* is the end of file marker.   *)
  114.  
  115.       IF ( ArcEntry.Version = 0 ) THEN
  116.          Error := End_Of_File
  117.       ELSE                         (* Not end of file marker -- get entry data. *)
  118.          WITH ArcEntry DO
  119.             BEGIN
  120.                                    (* Get position of next archive header *)
  121.  
  122.                Archive_Pos := Archive_Pos + Size +
  123.                               Archive_Header_Length;
  124.  
  125.                                    (* Adjust for older archives *)
  126.  
  127.                IF ( Version = 1 ) THEN
  128.                   BEGIN
  129.                      OLength := Size;
  130.                      Version := 2;
  131.                      DEC( Archive_Pos , 2 );
  132.                   END;
  133.  
  134.             END;
  135.                                     (* Report success/failure to calling *)
  136.                                     (* routine.                          *)
  137.  
  138.    Get_Next_Archive_Entry := ( Error = 0 );
  139.  
  140. END   (* Get_Next_Archive_Entry *);
  141.  
  142. (*----------------------------------------------------------------------*)
  143. (*      Display_Archive_Entry --- Display archive file entry info       *)
  144. (*----------------------------------------------------------------------*)
  145.  
  146. PROCEDURE Display_Archive_Entry( Archive_Entry : Archive_Entry_Type );
  147.  
  148. VAR
  149.    SDate      : STRING[10];
  150.    STime      : STRING[12];
  151.    I          : INTEGER;
  152.    FName      : AnyStr;
  153.    RLength    : LONGINT;
  154.    TimeDate   : LONGINT;
  155.    TimeDateW  : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  156.  
  157. BEGIN (* Display_Archive_Entry *)
  158.  
  159.    WITH Archive_Entry DO
  160.       BEGIN
  161.                                    (* Pick up file name *)
  162.  
  163.          Fname := COPY( FileName, 1, PRED( POS( #0 , FileName ) ) );
  164.  
  165.                                    (* See if this file matches the   *)
  166.                                    (* entry spec wildcard.  Exit if  *)
  167.                                    (* not.                           *)
  168.  
  169.          IF Use_Entry_Spec THEN
  170.             IF ( NOT Entry_Matches( Fname ) ) THEN
  171.                EXIT;
  172.                                    (* Make sure room on current page *)
  173.                                    (* for this entry name.           *)
  174.                                    (* If enough room, print blank    *)
  175.                                    (* line if requested.  This will  *)
  176.                                    (* only happen for first file.    *)
  177.          IF Do_Blank_Line THEN
  178.             BEGIN
  179.                IF ( Lines_Left < 2 ) THEN
  180.                   Display_Page_Titles
  181.                ELSE
  182.                   BEGIN
  183.                      WRITELN( Output_File );
  184.                      DEC( Lines_left );
  185.                   END;
  186.                Do_Blank_Line := FALSE;
  187.             END
  188.          ELSE
  189.             IF ( Lines_Left < 1 ) THEN
  190.                Display_Page_Titles;
  191.  
  192.                                    (* Add '. ' to front if we're     *)
  193.                                    (* expanding ARCs in main listing *)
  194.          IF Expand_Libs_In THEN
  195.             Fname := '. ' + Fname;
  196.  
  197.                                    (* Get original file size *)
  198.  
  199.          RLength := Olength;
  200.  
  201.                                    (* Get date and time of creation *)
  202.  
  203.          TimeDateW[1] := Time;
  204.          TimeDateW[2] := Date;
  205.  
  206.          Dir_Convert_Date_And_Time( TimeDate , SDate , STime );
  207.  
  208.                                    (* Write out file name, length, date, time *)
  209.  
  210.          WRITE( Output_File , Left_Margin_String, '      ' , FName );
  211.  
  212.          FOR I := LENGTH( FName ) TO 14 DO
  213.             WRITE( Output_File , ' ' );
  214.  
  215.          WRITE  ( Output_File , RLength:8, '  ' );
  216.          WRITE  ( Output_File , SDate, '  ' );
  217.          WRITE  ( Output_File , STime );
  218.          WRITELN( Output_File );
  219.  
  220.                                    (* Count lines left on page *)
  221.          IF Do_Printer_Format THEN
  222.             DEC( Lines_Left );
  223.  
  224.                                    (* Increment total entry count *)
  225.  
  226.          INC( Total_Entries );
  227.  
  228.                                    (* Increment total space used  *)
  229.  
  230.          Total_ESpace := Total_ESpace + RLength;
  231.  
  232.       END;
  233.  
  234. END (* Display_Archive_Entry *);
  235.  
  236. (*----------------------------------------------------------------------*)
  237.  
  238. BEGIN (* Display_Archive_Contents *)
  239.  
  240.                                    (* Set left margin spacing *)
  241.  
  242.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , Library_Indent );
  243.  
  244.                                    (* Set file title *)
  245.  
  246.    File_Title := Left_Margin_String + ' Archive file: ' + ArcFileName;
  247.  
  248.                                    (* Display archive file's name *)
  249.    IF Do_Printer_Format THEN
  250.       IF ( Lines_Left < 3 ) THEN
  251.          Display_Page_Titles;
  252.                                    (* If we're listing contents at end  *)
  253.                                    (* of directory, print archive name. *)
  254.                                    (* Do_Blank_Line flags whether we    *)
  255.                                    (* need to print blank line in entry *)
  256.                                    (* lister subroutine.  If listing    *)
  257.                                    (* inline, then it's true for the    *)
  258.                                    (* first file; otherwise it's false. *)
  259.                                    (* This is to prevent unnecessary    *)
  260.                                    (* blank lines in output listing     *)
  261.                                    (* when no files are selected from   *)
  262.                                    (* a given archive.                  *)
  263.    IF ( NOT Expand_Libs_In ) THEN
  264.       BEGIN
  265.          WRITELN( Output_File ) ;
  266.          WRITE  ( Output_File , File_Title );
  267.          DEC( Lines_Left , 2 );
  268.          Do_Blank_Line := FALSE;
  269.       END
  270.    ELSE
  271.       Do_Blank_Line := TRUE;
  272.                                    (* Try opening archive file for processing *)
  273.  
  274.    Open_File( ArcFileName , ArcFile, Archive_Pos, Ierr );
  275.  
  276.                                    (* Issue error message if open fails *)
  277.    IF ( Ierr <> 0 ) THEN
  278.       BEGIN
  279.          WRITELN( Output_File ,
  280.                   DUPL( ' ' , MAX( 0 , MIN( 12 , 13 - LENGTH( ArcFileName ) ) ) ),
  281.                   '     Can''t open archive file ',ArcFileName );
  282.          IF Do_Printer_Format THEN
  283.             BEGIN
  284.                DEC( Lines_Left );
  285.                IF ( Lines_Left < 1 ) THEN
  286.                   Display_Page_Titles;
  287.             END;
  288.          EXIT;
  289.       END
  290.    ELSE IF ( NOT Expand_Libs_In ) THEN
  291.       BEGIN
  292.  
  293.          WRITELN( Output_File );
  294.          WRITELN( Output_File );
  295.                                    (* Count lines left on page *)
  296.          IF Do_Printer_Format THEN
  297.             DEC( Lines_Left );
  298.  
  299.       END;
  300.                                    (* Loop over entries in archive file *)
  301.  
  302.    WHILE( Get_Next_Archive_Entry( Archive_Entry , Ierr ) ) DO
  303.       Display_Archive_Entry( Archive_Entry );
  304.  
  305.                                    (* Print blank line after last entry   *)
  306.                                    (* in archive, if we're expanding      *)
  307.                                    (* archives right after listing them,  *)
  308.                                    (* but only if archive had any entries *)
  309.                                    (* listed.                             *)
  310.  
  311.    IF ( Expand_Libs_In AND ( NOT Do_Blank_Line ) ) THEN
  312.       BEGIN
  313.          WRITELN( Output_File );
  314.          IF Do_Printer_Format THEN
  315.             DEC( Lines_Left );
  316.       END;
  317.                                    (* Close archive file *)
  318.    Close_File( ArcFile );
  319.                                    (* Restore previous left margin spacing *)
  320.  
  321.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  322.  
  323.                                    (* No file title *)
  324.    File_Title := '';
  325.  
  326. END   (* Display_Archive_Contents *);
  327.